home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / subckt.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  3.1 KB  |  100 lines
  1.       subroutine subckt
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine drives the expansion of subcircuit calls.
  5. c
  6. c spice version 2g.6  sccsid=tabinf 3/15/83
  7.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  8.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  9.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  10.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  11.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  12.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  13.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  14.      7   irowno,jcolno,nttbr,nttar,lvntmp
  15. c spice version 2g.6  sccsid=cirdat 3/15/83
  16.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  17.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  18. c spice version 2g.6  sccsid=flags 3/15/83
  19.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  20.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  21. c spice version 2g.6  sccsid=blank 3/15/83
  22.       common /blank/ value(200000)
  23. c spice version 2g.6  sccsid=status 3/15/83
  24.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  25.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  26.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  27.       integer nodplc(64)
  28.       complex cvalue(32)
  29.       equivalence (value(1),nodplc(1),cvalue(1))
  30. c
  31. c
  32. c... avoid 'call by value' problems, make inodi, inodx arrays
  33. c... in routines which receive them as parameters ]]]
  34.       locx=locate(19)
  35.    10 if (locx.eq.0) go to 300
  36.       locs=nodplc(locx+3)
  37.       asnam=value(iunsat+locs)
  38.       call fndnam(asnam,locx-1,locx+3,20)
  39.       if (nogo.ne.0) go to 300
  40.       locs=nodplc(locx+3)
  41. c
  42. c  check for recursion
  43. c
  44.       isbptr=nodplc(locx-1)
  45.    20 if (isbptr.eq.0) go to 30
  46.       if (locs.eq.nodplc(isbptr+3)) go to 260
  47.       isbptr=nodplc(isbptr-1)
  48.       go to 20
  49. c
  50. c
  51.    30 call sizmem(nodplc(locx+2),nxnod)
  52.       call sizmem(nodplc(locs+2),nssnod)
  53.       if (nxnod.ne.nssnod) go to 250
  54.       call getm4(inodx,nssnod)
  55.       call getm4(inodi,nssnod)
  56.       itemp=nodplc(locs+2)
  57.       call copy4(nodplc(itemp+1),nodplc(inodx+1),nssnod)
  58.       itemp=nodplc(locx+2)
  59.       call copy4(nodplc(itemp+1),nodplc(inodi+1),nxnod)
  60. c
  61. c  add elements of subcircuit to nominal circuit
  62. c
  63.       loc=nodplc(locs+3)
  64.   100 if (loc.eq.0) go to 200
  65.       id=nodplc(loc-1)
  66.       if (id.eq.20) go to 110
  67.       call find(dble(jelcnt(id)),id,loce,1)
  68.       nodplc(loce-1)=locx
  69.       call addelt(loce,loc,id,inodx,inodi,nxnod)
  70.   110 loc=nodplc(loc)
  71.       go to 100
  72. c
  73. c
  74.   200 call clrmem(inodx)
  75.       call clrmem(inodi)
  76.       locx=nodplc(locx)
  77.       go to 10
  78. c
  79. c  errors
  80. c
  81.   250 locv=nodplc(locx+1)
  82.       axnam=value(locv)
  83.       locv=nodplc(locs+1)
  84.       asnam=value(locv)
  85.       write (iofile,251) axnam,asnam
  86.   251 format('0*error*:  ',a8,' has different number of nodes than ',a8/
  87.      1)
  88.       nogo=1
  89.       go to 300
  90.   260 locsv=nodplc(locs+1)
  91.       asnam=value(locsv)
  92.       write (iofile,261) asnam
  93.   261 format('0*error*:  subcircuit ',a8,' is defined recursively'/)
  94.       nogo=1
  95. c
  96. c  finished
  97. c
  98.   300 return
  99.       end
  100.